Análise de Teor Político de Propagandas do Facebook
O objetivo do presente projeto é o de analisar o teor político de diferentes textos utilizados como propagandas no Facebook. Para isso, utilizaremos uma base de dados presente no Kaggle, que pode ser acessada neste link.
Essa base foi originalmente gerada pela ONG de jornalistmo investigativo ProPublica em uma página direcionada a análise desse tipo de propaganda.
Os insights gerados por esse tipo de estudo podem ser úteis para que tenhamos a capacidade de compreender o que leva um usuário a classificar uma postagem como poítica ou como não política: essa base foi criada a partir de uma extensão de navegador do instituto, que permite que votos sejam recebidos para cada mensagem diferente de Marketing recebida pelos browsers.
Com base nisso, um sistema de classificação do Instituto gera uma probabilidade de que a postagem seja política. Em nosso presente contexto, vamos ignorar tal dado. Iremos, com efeito, considerar apenas os textos e as votações dos usuários (além de suas datas de postagem e de atualização).
Comecemos pela importação das bibliotecas
## -- Attaching packages --------------------------------------------------------------------------------------------- tidyverse 1.3.0 --
## v ggplot2 3.3.1 v purrr 0.3.4
## v tibble 3.0.1 v dplyr 1.0.0
## v tidyr 1.1.0 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.5.0
## -- Conflicts ------------------------------------------------------------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
## Loading required package: NLP
##
## Attaching package: 'NLP'
## The following object is masked from 'package:ggplot2':
##
## annotate
## Loading required package: plyr
## ------------------------------------------------------------------------------
## You have loaded plyr after dplyr - this is likely to cause problems.
## If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
## library(plyr); library(dplyr)
## ------------------------------------------------------------------------------
##
## Attaching package: 'plyr'
## The following objects are masked from 'package:dplyr':
##
## arrange, count, desc, failwith, id, mutate, rename, summarise,
## summarize
## The following object is masked from 'package:purrr':
##
## compact
## Loading required package: rjson
## Loading required package: RCurl
##
## Attaching package: 'RCurl'
## The following object is masked from 'package:tidyr':
##
## complete
## Loading required package: RColorBrewer
## Loading required package: koRpus.lang.en
## Loading required package: koRpus
## Loading required package: sylly
## For information on available language packages for 'koRpus', run
##
## available.koRpus.lang()
##
## and see ?install.koRpus.lang()
##
## Attaching package: 'koRpus'
## The following object is masked from 'package:readr':
##
## tokenize
## Parsed with column specification:
## cols(
## .default = col_character(),
## political = col_double(),
## not_political = col_double(),
## created_at = col_datetime(format = ""),
## updated_at = col_datetime(format = ""),
## impressions = col_double(),
## political_probability = col_double(),
## suppressed = col_logical(),
## targetedness = col_double(),
## listbuilding_fundraising_proba = col_double()
## )
## See spec(...) for full column specifications.
## [1] "id" "html"
## [3] "political" "not_political"
## [5] "title" "message"
## [7] "thumbnail" "created_at"
## [9] "updated_at" "lang"
## [11] "images" "impressions"
## [13] "political_probability" "targeting"
## [15] "suppressed" "targets"
## [17] "advertiser" "entities"
## [19] "page" "lower_page"
## [21] "targetings" "paid_for_by"
## [23] "targetedness" "listbuilding_fundraising_proba"
A tabela é extremamente pesada e ocupa \(3 GB\) de memória. O seu número de linhas é \(162.324\):
## [1] 162324
Precisamos então filtrar tais informações, sem que isso signifique uma perda em nosso poder de análise. Para descobrir como filtrar a tabela de maneira adequada, precisamos, antes de iniciarmos, efetivamente, a análise dos textos, explorar os dados básicos e determinar um procedimento coerente de amostragem.
Análise Exploratória Básica de Dados
Iniciaremos filtrando apenas as nossas colunas de interesse:
cols_list <- c('id', 'title', 'message', 'political', 'not_political', 'created_at', 'updated_at')
df_ads <- df_ads %>% select(one_of(cols_list))
datatable(df_ads %>% head(20) %>% select(-message))Estamos expondo aqui todas as colunas, à exceção do texto original, pois o texto possui um extenso número de caracteres. Iremos iniciar nossa análise observando a distribuição dos votos de político / não político e verificando quais instantes de tempo (datetimes) temos a nossa disposição. Iniciemos observando o histograma das datas de postagem e de update dos posts:
df_dates <- data.frame(
Data = c(df_ads$created_at, df_ads$updated_at),
Tipo = c(rep('Criação', nrow(df_ads)), rep('Atualização', nrow(df_ads)))
)
ggplot(df_dates, aes(x = Data, fill = Tipo)) +
geom_histogram(color = 'black', position = 'dodge') +
theme(text = element_text(size = 14)) +
ylab('Contagem') + ggtitle('Distribuição de Postagens no Tempo')## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Podemos observar que a distribuição das atualizações e criações de novos posts de propaganda são extremamente não uniformes ao longo do tempo. Além disso, tais postagems e atualizações alcançaram um grande pico no final de \(2018\) e em meads de maio de \(2019\). Não podemos simplesmente filtrar amostras mais recentes para reduzir nosso dataframe pois isso implicaria em suprimir fenômenos importantes que aconteceram no passado e em desbalancear o peso das ocorrências. Assim, chegamos aqui à nossa primeira diretriz: > Iremos realizar uma amostragem do dataframe inicial mantendo a mesma distribuição na data de criação (como os dois histogramas são similares, poderíamos também utilizar a atualização como referência sem que isso implicasse em grandes prejuízos).
Precisamos, no entanto, analisar também o teor político ou não político de nossas amostras. Podemos, a princípio, traçar as distribuições desses parâmetros de maneira similar:
df_votes <- data.frame(
N.Votos = c(df_ads$political, df_ads$not_political),
Tipo = c(rep('Político', nrow(df_ads)), rep('Não Político', nrow(df_ads)))
)
ggplot(df_votes, aes(x = N.Votos, fill = Tipo)) +
geom_histogram(color = 'black', position = 'dodge') +
theme(text = element_text(size = 14)) +
ylab('Número de Posts') + ggtitle('Distribuição de Postagens por Votos') +
scale_x_sqrt() + scale_y_sqrt()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Podemos observar que temos muitas postagens com \(0\) votos tanto para “político” quanto para “não político”. Porém, podemos observar que postagens que possuem \(0\) votos tendem a ser não políticas e quanto mais votos uma postagem recebe, maior é a tendência de a mesma ser “não política”. Como estamos falando sobre comparar postagens políticas com postagens não políticas, iremos tentar balancear as amostras com relação a este parâmetro. Logo:
- Queremos manter a mesma distribuição do dataframe original no que diz respeito às datas (pois os tópicos são dinâmicos com relação ao tempo).
- Queremos balancear com relação a posts políticos e não políticos (pois temos a intenção de diferenciar um tipo de propaganda da outra e, por isso, precisamos de muitas amostras para ambos os casos).
Assim, nosso procedimento de amostragem consistirá em:
- Dividir o dataframe original em dois grupos: (A) um grupo formado pelas propagandas nas quais a maior parte dos votos é político e (B) um grupo formado pelas propagandas nas quais a menor parte dos votos é não política (não iremos considerar postagens nas quais nenhum voto foi realizado).
- Para cada uma das amostras obtidas no passo anterior, iremos realizar uma amostragem estratificada com relação ao tempo no qual o post foi criado.
Queremos um número pequeno de amostras para que tenhamos a capacidade computacional de processar os dados seguidamente de forma eficiente. A utilização integral desses dados seria desejável apenas na etapa na qual o sistema seria posto em produção. Iremos obter uma amostra de \(4000\) linhas.
Para isso iremos criar uma variável de estratificação. Ela será composta por dois termos: o tipo de variável (se ela é política ou não política) e o quantil da data considerada (iremos quebrar a data em 10 quantis):
df_ads_strat <- df_ads
df_ads_strat$tentile <- df_ads_strat$created_at %>% ntile(10)
df_ads_strat <- df_ads_strat %>% mutate(strat_group = tentile %>%
as.character %>%
str_c('_') %>%
str_c(if_else(political > not_political, 'Political', 'NotPolitical')))
df_ads_strat <- df_ads_strat %>% filter(political + not_political > 0)
df_ads_strat %>% head(10) %>% select(-one_of('message'))## # A tibble: 10 x 8
## id title political not_political created_at updated_at
## <chr> <chr> <dbl> <dbl> <dttm> <dttm>
## 1 hype~ Plan~ 0 1 2019-03-27 17:18:29 2019-04-11 15:02:58
## 2 6080~ PRI ~ 7 5 2018-02-09 14:00:09 2018-03-20 18:17:02
## 3 2384~ Grea~ 4 1 2018-11-29 06:23:22 2019-01-02 21:20:22
## 4 6097~ The ~ 4 1 2018-09-13 20:49:05 2018-09-14 09:36:47
## 5 2384~ Angi~ 5 0 2018-09-13 20:44:50 2018-09-13 22:23:49
## 6 2384~ Plan~ 0 1 2017-12-23 20:22:23 2017-12-25 03:12:23
## 7 6110~ Huma~ 0 1 2018-04-06 19:42:16 2018-04-08 18:47:43
## 8 6084~ Join~ 2 1 2017-12-06 21:38:39 2017-12-07 20:55:35
## 9 2384~ No K~ 1 3 2018-12-24 00:11:12 2019-01-27 14:51:45
## 10 6097~ Asso~ 1 0 2018-06-25 03:07:58 2018-08-10 04:15:44
## # ... with 2 more variables: tentile <int>, strat_group <chr>
Agora iremos aplicar uma amostragem estratificada utilizando a variável “strat_group” como grupo de estratificação. Para isso, iremos olhar para cada grupo separadamente e para cada um deles iremos amostrar aleatoriamente \(200\) variáveis. Como temos \(20\) grupos (\(10\) quantis para político e para não político), obteremos, ao final, as \(4000\) amostras que desejamos em nosso dataframe reduzido:
id_list <- c()
for (current_strat_group in unique(df_ads_strat$strat_group)) {
df_current_group <- df_ads_strat %>% filter(strat_group == current_strat_group)
id_list <- c(id_list, df_current_group$id[sample.int(nrow(df_current_group), 200)])
}
df_sample_ads <- df_ads_strat %>% filter(id %in% id_list)
print('Número final de amostras:')## [1] "Número final de amostras:"
## [1] 4000
Finalmente, podemos iniciar nossa análise de texto com um dataframe reduzido e que mantém as características desejadas da amostra inicial bem como um devido balanceamento de dados políticos e não políticos.
Limpeza / Mineração de Dados
O pacote de “text mining” (TM) será utilizado pra que obtenhamos um conjunto de textos sem pontuações, números ou palavras que fogem do interesse de nossa análise (como artigos e preposições). Definindo as funções de limpeza de strings:
removeHTML <- function(x) (return(gsub('<.*?>', ' ', x)))
removeURL <- function(x) (return(gsub('http[[:alnum:]]*', ' ', x)))
removeAccents <- function(x) (return(stri_trans_general(str = x, id = 'Latin-ASCII')))
removeNonAlphanum <- function(x) (return(gsub('[^[:alnum: ]]', ' ', x)))
stop_words_list <- c(stopwords(kind = 'SMART'), 'time', 'back', 'today', 'day', 'dont')
removeSelectedWords <- function(x) (return(removeWords(x, stop_words_list)))
clean_str <- function(df_in, merge_string = TRUE) {
final_cleaning <- function(x) {
x %>%
tolower %>%
removeHTML %>%
removeURL %>%
removeAccents %>%
removeNonAlphanum %>%
removeNumbers %>%
removeSelectedWords %>%
removePunctuation %>%
str_trim %>% return()
}
df_in_proc <- df_in %>% mutate(text = str_c(title, ' ', message))
if (merge_string) {
return(
final_cleaning(
paste(df_in_proc$text, collapse = ' ')))
}
return(df_in_proc$text %>% lapply(final_cleaning))
}Definindo uma função para gerar um objeto do tipo “TermDocumentMatrix” com a realização da operação de lematização:
get_tdmat <- function(str_in) {
str_in %>%
VectorSource %>%
Corpus %>%
(function(x) (tm_map(x, lemmatize_words))) %>%
TermDocumentMatrix %>%
return()
}Finalmente, definimos a função que transforma o objeto “TermDocumentMatrix” em uma matriz de frequências, que utilizaremos para gerar um WordCloud:
get_df_words_freq <- function(tdMat) {
counts <- sort(rowSums(as.matrix(tdMat)), decreasing = TRUE)
counts <- counts[grepl('^[a-z]+$', names(counts))]
frame_counts <- data.frame(word = names(counts), freq = counts)
return(frame_counts)
}beautiful_wordcloud <- function(df_freq) {
return(
wordcloud(
df_freq$word,
freq = df_freq$freq,
scale=c(2.5, 0.5),
random.order=FALSE,
max.words = 50,
colors = brewer.pal(8, "Dark2"),
rot.per=0,)
)
}word_cloud_plot_pipeline <- function(str_in) {
str_in %>%
clean_str %>%
get_tdmat %>%
get_df_words_freq %>%
beautiful_wordcloud %>%
return()
}## NULL
## NULL
Podemos observar que muitas propagandas políticas estão relacionadas a termos como “campanha”, “trump”, “votar” e “congresso”. É interessante notar que o verbo “make” está também presente na WordCloud e isso muito provavelmente é devido ao fato de a palavra “make” fazer parte da campanha de Donald Trump (“Make America great again”).
Com relação às postagens não políticas, a palavra “presente” parece assumir um forte papel. Assim, muitas propagandas que não são de teor político tendem a ser anúncios de presentes. Porém, além disso, palavras como “proteger”, “cuidado”, “emergência”, “resgate” e “doação” aparecem, indicando que existem também diversos posts de propagandas não políticas relacionadas a ONG’s.
A partir dos insights aqui gerados, podemos gerar um conjunto de diferentes grafos para permitir que nossa análise de dados seja enriquecida:
A. Grafos de palavras “políticas” e palavras “apolíticas” > São os grafos mais básicos e vai permitir que a gente confira como as entidades se relacionam para cada uma das duas possíveis classificações.
B. Grafos de Ego > Podemos analisar os dois casos que nos chamaram atenção - para o Wordcloud “apolítico”, podemos fazer uma rede ego ao redor de “Trump” e para o wordcloud “apolítico” podemos fazer uma rede de ego ao redor de “Gift” e interpretar os resultados.
C. Grafos Bipartides > Uma outra possibilidade que iremos propor é a de um grafo bipartide na qual nós relacionados a palavras podem se ligar a dois nós de outra partição: o nó “POLÍTICO” ou o nó “APOLÍTICO”. O peso de ligação entre uma palavra e o nó “POLÍTICO” seria igual ao seu peso na tabela de frequência gerada ao plotar o Wordcloud de palavras de posts políticos e, simetricamente, o peso de ligação entre cada palavra e o nó “APOLÍTICO” seria igual ao seu peso na tabela de frequência do Wordcloud de palavras de posts não políticos.
Antes de fazermos essa análise de grafos, iremos classificar as palavras e extrair as entidades por meio da biblioteca SpacyR. Ela permite que encontremos quem é EVENTO, ORGANIZAÇÃO, PESSOA etc. Esse tipo de classificação pode ser especialmente útil no aprimoramento da análise de grafos - podemos, por exemplo, verificar quais EVENTOS se relacionam à palavra TRUMP ou ainda visualizar como entidades do tipo PESSOA se relacionam com entidadesdo tipo ORGANIZAÇÃO.
Assim, iremos manipular a biblioteca SpacyR na próxima seção, preliminarmente à geração dos grafos.
Identificação de Entidades com SpacyR
Por meio da função “spacy_extract_entity” iremos classificar as entidades para o caso em que a mensagem foi classificada como política e para o caso em que a mensagem foi classificada como não política:
## Found 'spacy_condaenv'. spacyr will use this environment
## successfully initialized (spaCy Version: 2.2.4, language model: en_core_web_sm)
## (python options: type = "condaenv", value = "spacy_condaenv")
extract_entity <- function(x) (
return (spacy_extract_entity(x %>% (function(x)(clean_str(x, FALSE))) %>% unlist)))
political_entities <- extract_entity(df_sample_ads %>% filter(political > not_political))
not_political_entities <- extract_entity(df_sample_ads %>% filter(political < not_political))Temos então, para o caso de entidades políticas:
E des não políticas:<div ib437b112f7ee07" style="width:100%;height:auto;" class="datatables html-widget">
[1] “CARDINAL” “PERSON” “ORG” “DATE” “NORP”
[6] “GPE” “MONEY” “FAC” “LOC” “PRODUCT”
[11] “TIME” “QUANTITY” “PERCENT” “ORDINAL” “EVENT”
[16] “LAW” “LANGUAGE” “WORK_OF_ART”
Podemos tentar verificar se alguns tipos de entidades são mais comuns para determinado tipo:
```r
df_political_hist <- political_entities %>% count('ent_type')
df_not_political_hist <- not_political_entities %>% count('ent_type')
df_political_hist$freq <- df_political_hist$freq
df_not_political_hist$freq <- df_not_political_hist$freq
df_political_hist$type <- 'Político'
df_not_political_hist$type <- 'Não Político'
rbind(df_political_hist, df_not_political_hist) -> df_entity_distrib
Representando esses resultados graficamente:
ggplot(df_entity_distrib, aes(x = ent_type, y = freq, fill = type)) +
geom_bar(stat = 'identity', color = 'black', position = 'dodge') +
facet_wrap(facets = vars(ent_type), ncol = 3, scales = 'free') +
theme_minimal()Aqui tiramos algumas conclusões muito interessantes:
- Eventos tendem fortemente a ocorrer em postagens que não são políticas
- Linguagem sempre ou quase sempre (a depender do seed) apareceu em postagens sem teor político
- O mesmo pode ser dito em relação a quantidade, percentuais e a “work of arts” (livros músicas etc.) - Isso se relaciona ao fato de postagens não políticas terem forte influência da palavra “GIFT” - Provavelmente são postagens de vendas, com valores, custos e numerais em geral
- Leis aparecem com 100% de chance (ou quase 100% de chance) em postagens de teor político (o que é, de fato, intuitivo)
Podemos listar quais desses tipos são interessantes para nossa análise:
PERSON: > Pode ser útil no contexto de identificar ligações entre pessoas no meio político
NORP: > Engloba religiões e grupos ideológicos, inclusive os de caráter político
ORG: > O estudo da relação entre as organizações pode auxiliar na análise
LAW: > Leis podem ser o diferencial entre um caso e outro
WORK OF ART: > Se existe esse tipo de entidade numa publicidade, é improvável que seja de cunho político, pois engloba músicas, livros etc.
EVENT: > Eventos podem conectar pessoas e organizações. Manteremos essa entidade aqui
PRODUCT: > No gráfico vimos que temos muitos produtos ligados a ambos os tipos de postagens, quais produtos se ligam a cada tipo?
É com foco nesses tipos de entidades que iniciaremos na próxima seção a plotagem dos grafos.
Análise de Grafos
Os grafos serão gerados por meio da ferramenta Gephi. Temos que gerar as matrizes de adjacências para cada uma das situações propostas anteriormente. Antes de iniciarmos a geração de tais matrizes, iremos filtrar os tipos de entidades que serão estudados:
Grafos Gerais - Político X Não Político
Neste caso, duas entidades serão adjacentes sempre que pertencerem a uma mesma postagem e o peso das arestas será igual ao número de posts compartilhados por cada par de nós (entidades). De acordo com a documentação do Gephi, podemos simplesmente exportar um dataframe com as combinações de pares ligados e, no caso de haver mais de uma ligação, o peso da aresta será incrementado automaticamente.
get_adj_list <- function(df_ent) {
list_node1 <- c()
list_node2 <- c()
df_ents_to_read <- df_ent
doc_list <- unique(df_ent$doc_id)
for (current_doc in doc_list) {
df_current_doc <- df_ent %>% filter(doc_id == current_doc)
n_ent_curr_doc <- nrow(df_current_doc)
if (n_ent_curr_doc > 2) {
for (i in 1:(n_ent_curr_doc - 1)) {
for (j in (i + 1):(n_ent_curr_doc)) {
list_node1 <- c(list_node1, df_current_doc$text[[i]])
list_node2 <- c(list_node2, df_current_doc$text[[j]])
}
}
}
# Otimizar velocidade na hora da filtragem
df_ents_to_read <- df_ents_to_read %>% filter(doc_id != current_doc)
}
return(data.frame(node1 = list_node1, node2 = list_node2))
}
get_adj_list(political_entities) %>% write_csv(path = 'political_adj.csv')
get_adj_list(not_political_entities) %>% write_csv(path = 'not_political_adj.csv')Finalmente, com esses arquivos gerados, podemos exibir nosso primeiro par de grafos. Para ambos, o procedimento adotado foi o de (1) dar aos nós e arestas tamanhos e cores variáveis de acordo com o grau de ligação, (2) aplicar o algoritmo de Force Atlas para separar os nós e (3) aplicar o algorimo de “no overlap” para separá-los, (4) aplicar um filtro para selecionar apenas os nós e arestas relativos aos maiores graus (para permitir uma boa visualização).
Para o caso político:
Grafo político
Para o caso não político, temos que analisar o grafo com mais paciência. Quando realizamos a plotagem do grafo, foi possível identificar a presença de “dois grandes grupos” ao organizarmos os nós por meio do algoritmo de Force Atlas:
Grafo não político
Temos um grupo superior e um inferior com nós de graus extremamente grandes conectando os dois “clusters”. Podemos observar cada uma das posições. Na parte inferior temos:
Grafo não político
E podemos observar muitos casos de palavras ligados a países, dias da semana, nacionalidades e outros aspectos pouco relevantes para uma boa caracterização do que seria uma “propaganda apolítica”. Porém, podemos notar que existem algumas entidades como “partido republicano” que se encontram em postagens nas quais existem mais votos a favor de “não político” e que se encontram em tais postagens com elevado grau.
Isso nos leva a concluir que palavras relacionadas ao partido republicano parecem tender a possuir um elevado número de falsos positivos no processo de classificação do tipo de postagem. Continuemos nossa análise - vamos olhar, agora, a parte superior do grafo:
Grafo não político
Aqui podemos notar um elevado número de termos, nomes, regiões e locais de natureza latina ou relacionados ao sul dos EUA. Então, aparentemente, indivíduos (como atorese artistas) e organizações relacionadas a esses elementos tendem a, por alguma razão, serem ativos na disseminação de propagandas não políticas do Facebook.
Resumindo, nessa seção concluimos que:
Existem palavras que dão forte probabilidade de o post ser político > Mas temos que ter cuidado! Termos ligados ao “partido republicano” parecem ser controversos nesse sentido
Existe um cluster de termos latinoamericanos fortemente relacionado a regiões do sul dos EUA que aparecem fortemente em postagens não políticas.
Podemos também notar a presença forte do termo “American” em ambos os casos. Assim, existem termos que não parecem exercer um papel relevante no processo de classificação.
Com isso, podemos prosseguir e desenhar o grafo de ego relacionado a “Donald Trump” para estudar uma das entidades mais fortemente presente no wordcloud político.
Grafo de EGO: Utilizando a entidade “Donald Trump” como exemplo
Iremos traçar o grafo de ego relacionado a “Donal Trump” a partir do grafo geral criado na seção anterior. Efetuando os ajustes necessários no Gephi, obtemos:
Trump graph
Nesse caso, utilizamos uma combinação de Frutchman-Reynold com No Overlap para organizar a rede de ego de forma a deixar o termo “Donal Trump” na posição central. Também foi necessário, no Gephi, realizar um merge entre as entidades “Donald”, “Trump”e “Donald Trump”. Com isso, foi possível verificar, principalmente, a relação do político com as demais instituições além de termos como “medicare”, “fox news” ou “bob casey” (ao pesquisar, verificamos que Bob Casey é um político do partido democrata).
Assim, foi possível obter, principalmente, a relação entre Donald Trump e outras instituições, além de tópicos abordados em possíveis debates e outros indivíduos que com ele se relacionam.
Nosso próximo passo é gerar a rede bipartide, na qual iremos ligar cada nó a “POLÍTICO” ou a “NÃO POLÍTICO”, permitindo mapear de maneira mais efetiva quais palavras tendem a caracterizar determinado tipo mais fortemente e quais palavras tendem a aparecer com abundância em textos de ambas as classificações.